home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbufi.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-12  |  5.1 KB  |  139 lines
  1. (*===========================================================================*)
  2. (* Open/Close/Reorg UID file                                                 *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989 by H. Roy Engehausen.  All rights reserved.        *)
  5. (*   This software may be freely distributed and used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   for no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. (*===========================================================================*)
  13. (* Open uid file                                                             *)
  14. (*===========================================================================*)
  15.  
  16. PROCEDURE open_uid(fileid : file_name_str);
  17.  
  18.   VAR
  19.     i                 : WORD;
  20.     uid_buffer        : user_record_type;
  21.     uid_index_current : user_index_ptr;
  22.  
  23.   BEGIN;
  24.  
  25.     (*-----------------------------------------------------------------------*)
  26.     (* Open uid file for read                                                *)
  27.     (*-----------------------------------------------------------------------*)
  28.  
  29.     ASSIGN(uid_file, fileid);
  30.     {$I-}
  31.     RESET(uid_file);
  32.     {$I+}
  33.  
  34.     (*-----------------------------------------------------------------------*)
  35.     (* File doesn't exist.  Initialize it                                    *)
  36.     (*-----------------------------------------------------------------------*)
  37.  
  38.     IF IORESULT <> 0 THEN
  39.       BEGIN;
  40.  
  41.         REWRITE(uid_file);
  42.  
  43.         FILLCHAR(uid_buffer, SIZEOF(uid_buffer), CHR(0));
  44.         uid_buffer.user_i_ptr := PTR(sys_version, sys_version);
  45.         WRITE(uid_file, uid_buffer);
  46.  
  47.         CLOSE(uid_file);
  48.  
  49.         RESET(uid_file);
  50.  
  51.       END;
  52.  
  53.     (*-----------------------------------------------------------------------*)
  54.     (* Check the version of the file                                         *)
  55.     (*-----------------------------------------------------------------------*)
  56.  
  57.     READ(uid_file, uid_buffer);
  58.     i := OFS(uid_buffer.user_i_ptr^);
  59.     IF i <> sys_version THEN
  60.       BEGIN;
  61.         WRITELN('Wanted version ', sys_version, ' user file');
  62.         WRITELN('Got version ', i, ' user file');
  63.         HALT;
  64.       END;
  65.  
  66.     (*-----------------------------------------------------------------------*)
  67.     (* Read in the user file                                                 *)
  68.     (*-----------------------------------------------------------------------*)
  69.  
  70.     uid_chain := NIL;
  71.     uid_free  := NIL;
  72.  
  73.     uid_total := 0;
  74.  
  75.     i         := FILESIZE(uid_file) - 1;
  76.  
  77.     WHILE uid_total < i DO
  78.       BEGIN;
  79.  
  80.         (*-------------------------------------------------------------------*)
  81.         (* Read in the next record                                           *)
  82.         (*-------------------------------------------------------------------*)
  83.  
  84.         READ(uid_file, uid_buffer);
  85.  
  86.         (*-------------------------------------------------------------------*)
  87.         (* Fill in fields as needed                                          *)
  88.         (*-------------------------------------------------------------------*)
  89.  
  90.         IF uid_buffer.user_n_time = 0 THEN
  91.           uid_buffer.user_n_time := uid_buffer.user_last;
  92.  
  93.         IF uid_buffer.user_lang = #0 THEN
  94.           uid_buffer.user_lang := '?';
  95.  
  96.         (*-------------------------------------------------------------------*)
  97.         (* Build index                                                       *)
  98.         (*-------------------------------------------------------------------*)
  99.  
  100.         NEW(uid_index_current);
  101.  
  102.         WITH uid_index_current^ DO
  103.           BEGIN
  104.  
  105.             user_id    := uid_buffer.user_id;
  106.             user_recno := uid_total + 1;
  107.  
  108.             IF ((uid_buffer.user_flag AND user_f_delete) <> 0)
  109.                                                         OR (user_id = '') THEN
  110.               BEGIN;
  111.                 user_next := uid_free;
  112.                 uid_free  := uid_index_current;
  113.               END
  114.             ELSE
  115.               insert_uid(uid_index_current);
  116.  
  117.           END;
  118.  
  119.         (*-------------------------------------------------------------------*)
  120.         (* Bump record number                                                *)
  121.         (*-------------------------------------------------------------------*)
  122.  
  123.         uid_total := uid_total + 1;
  124.  
  125.       END; (*----- End of loop reading records ------------------------------*)
  126.  
  127.   END;
  128.  
  129. (*===========================================================================*)
  130. (* Close uid file                                                            *)
  131. (*===========================================================================*)
  132.  
  133. PROCEDURE close_uid;
  134.  
  135.   BEGIN;
  136.     CLOSE(uid_file);
  137.  
  138.   END;
  139.